Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/cocktail/lalr.lha/lalr/src/Check.mi

Text File | 1992-08-18 | 13KB | 464 lines

(* check and repair inconsitences *)

(* $Id: Check.mi,v 2.4 1992/08/07 15:22:49 grosch rel $ *)

(* $Log: Check.mi,v $
 * Revision 2.4  1992/08/07  15:22:49  grosch
 * allow several scanner and parsers; extend module Errors
 *
 * Revision 2.3  1992/02/05  08:00:15  grosch
 * renamed NULL to DevNull
 *
 * Revision 2.2  1991/11/21  14:53:14  grosch
 * new version of RCS on SPARC
 *
 * Revision 2.1  91/03/19  14:19:23  grosch
 * fixed: IF Verbose THEN WriteClose (dFile); END;
 *
 * Revision 2.0  91/03/08  18:31:37  grosch
 * turned tables into initialized arrays (in C)
 * moved mapping tokens -> strings from Errors to Parser
 * changed interface for source position
 *
 * Revision 1.5  91/01/18  20:32:43  grosch
 * fixed resolution of reduce-reduce conflicts
 *
 * Revision 1.4  90/06/12  16:53:43  grosch
 * renamed main program to lalr, added { } for actions, layout improvements
 *
 * Revision 1.3     89/05/02  14:34:18  vielsack
 * new option: -v (verbose)
 *
 * Revision 1.2     89/01/02  16:17:34  vielsack
 * fixed bug (instead of a reduce reduce conflict a read reduce conflict
 * was reported)
 *
 * Revision 1.1     88/11/08  12:09:28  vielsack
 * report all read items in the conclusion (not only the representative)
 *
 * Revision 1.0     88/10/04  14:35:55  vielsack
 * Initial revision
 *
 *)

IMPLEMENTATION MODULE Check;

FROM Automaton    IMPORT Infinite, tAss, tRep, tIndex, tProduction, ProdArrayPtr,
            tStateIndex, StateArrayPtr, StateIndex, tItemIndex,
            ItemArrayPtr, OperArray;
FROM Debug    IMPORT dFile, tConflict, DebugHead, DebugState, DebugEnd, InformIgnored,
            InformLowPri, InformRightAss, InformLeftAss, InformKept,
            InformConflict, NewLine;
FROM Errors    IMPORT eInternal, eInformation, eWarning, eError, eFatal, eString,
            eShort, eTermSet, ErrorMessageI;
FROM Idents    IMPORT tIdent;
FROM IO        IMPORT WriteOpen, WriteClose;
FROM Sets    IMPORT tSet, IsElement, IsEmpty, Include, Exclude, Extract, Union,
            Intersection, Assign,  AssignEmpty, MakeSet, ReleaseSet;
FROM Strings    IMPORT tString, ArrayToString;
FROM SysError    IMPORT StatIsBad, SysErrorMessageI;
FROM SYSTEM    IMPORT ADR;
FROM Positions    IMPORT NoPosition;
FROM TokenTab    IMPORT MAXTerm, Terminal, Prio, TokenToSymbol, TokenError;

  CONST
    eState        = 70;
    eReadRed        = 71;
    eRedRed        = 72;
    eReadRedRed        = 73;
    eRepReadRed        = 74;
    eRepRedRed        = 75;
    eRepReadRedRed    = 76;
    eARepReadRed    = 77;
    eARepRedRed        = 78;
    eARepReadRedRed    = 79;

    DevNull    = '/dev/null';
    DEBUG    = '_Debug';

  PROCEDURE CheckForConflicts (VAR ok: BOOLEAN);

  (* Pruefe ob die Zustaende Konflikte beinhalten,
     so weit moeglich werden Konflikte mit Hilfe von
     Prioritaeten und Assoziativitaeten geloest,
     falls keine Korektur moeglich ist wird das Programm mit
     einer Fehlermeldung beendet, sonst steht ein konfliktfreier
     Automat zur Auswertung zur Verfuegung *)

    VAR
      SymbolSet,
      ConflictSet,
      TempSet  : tSet;
      state,
      maxState : tStateIndex;
      item     : tItemIndex;
      Error    : BOOLEAN;
      string   : tString;
    BEGIN
      Error := FALSE;
      MakeSet (SymbolSet,MAXTerm);
      MakeSet (ConflictSet,MAXTerm);
      MakeSet (TempSet,MAXTerm);

      IF Verbose THEN
    dFile := WriteOpen (DEBUG);
    IF StatIsBad (dFile) THEN
      ArrayToString (DEBUG, string);
      SysErrorMessageI (dFile, eError, eString, ADR (string));
      dFile := WriteOpen (DevNull);
      IF StatIsBad (dFile) THEN
        ArrayToString (DevNull, string);
        SysErrorMessageI (dFile, eFatal, eString, ADR (string));
      END;
    END;
      END;

      (* fuer Debug wird in Number ein Verweis auf den zugeh. State eingetragen *)

      maxState := StateIndex;
      FOR state := 1 TO maxState DO
    WITH StateArrayPtr^[state] DO
      FOR item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[item] DO
          Number := state;
        END;
      END;
    END;
      END;

      FOR state := 1 TO maxState DO
    WITH StateArrayPtr^[state] DO

      AssignEmpty (ConflictSet);
      AssignEmpty (SymbolSet);

      FOR item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[item] DO
          CASE Rep OF
          | TermRep :
          IF IsElement (Read,SymbolSet) THEN
            Include (ConflictSet,Read);
          ELSE
            Include (SymbolSet,Read);
          END;
          | RedRep :
          Assign (TempSet,Set);
          Intersection (TempSet,SymbolSet);
          Union (ConflictSet,TempSet);
          Union (SymbolSet,Set);
          ELSE
          END;
        END;
      END;

      IF NOT IsEmpty (ConflictSet) THEN
        RepairConflict (state, ConflictSet);
        IF NOT IsEmpty (ConflictSet) THEN Error := TRUE; END;
      END;
    END;
      END;

      ReleaseSet (TempSet);
      ReleaseSet (ConflictSet);
      ReleaseSet (SymbolSet);
      ok := NOT Error;
      IF Verbose THEN
        WriteClose (dFile);
      END;
    END CheckForConflicts;

PROCEDURE RepairConflict (state: tStateIndex; VAR ConflictSet: tSet);
    VAR
      todo                        : tSet;
      LookAhead                        : Terminal;
      ReadRedSet, RedRedSet, ReadRedRedSet, RepReadRedSet,
      RepRedRedSet, RepReadRedRedSet, ARepReadRedSet,
      ARepRedRedSet, ARepReadRedRedSet            : tSet;
      Priority, ReducePri, ShiftPri            : Prio;
      Associativity, ReduceAss, ShiftAss        : tAss;
      MinProdNo                        : tIndex;
      OnlyOpers                        : BOOLEAN;
      ReduceCount, ShiftCount, ReduceRest, ShiftRest    : CARDINAL;
      item                        : tItemIndex;
      prod                        : tProduction;
      ConflictFree                    : BOOLEAN;
    BEGIN
      MakeSet (ReadRedSet, MAXTerm);
      MakeSet (RedRedSet, MAXTerm);
      MakeSet (ReadRedRedSet, MAXTerm);
      MakeSet (RepReadRedSet, MAXTerm);
      MakeSet (RepRedRedSet, MAXTerm);
      MakeSet (RepReadRedRedSet, MAXTerm);
      MakeSet (ARepReadRedSet, MAXTerm);
      MakeSet (ARepRedRedSet, MAXTerm);
      MakeSet (ARepReadRedRedSet, MAXTerm);

      IF Verbose THEN
    DebugHead (state);
    DebugState (state, ConflictSet);
      END;

      MakeSet (todo, MAXTerm);
      Assign (todo, ConflictSet);

      WITH StateArrayPtr^[state] DO
    WHILE NOT IsEmpty (todo) DO
      LookAhead := Extract (todo);

      OnlyOpers := TRUE;
      ReduceCount := 0;
      ShiftCount := 0;
      ReduceRest := 0;
      ShiftRest := 0;
      ReducePri := 0;
      ReduceAss := none;
      ShiftPri  := 0;
      ShiftAss  := none;
      MinProdNo := 10000;

      FOR item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[item] DO
          IF (Rep = RedRep) AND IsElement (LookAhead, Set) THEN
        INC (ReduceCount);
        prod := ADR(ProdArrayPtr^[Prod]);
        IF prod^.Pri = 0 THEN
          OnlyOpers := FALSE;
        ELSIF prod^.Pri > ReducePri THEN
          ReducePri := prod^.Pri;
          ReduceAss := prod^.Ass;
        END;
        IF prod^.ProdNo < MinProdNo THEN
          MinProdNo := prod^.ProdNo;
        END;
          ELSIF (Rep = TermRep) AND (Read = LookAhead) THEN
        INC (ShiftCount);
        IF OperArray [LookAhead].Pri = 0 THEN
          OnlyOpers := FALSE;
        ELSE
          ShiftPri := OperArray [LookAhead].Pri;
          ShiftAss := OperArray [LookAhead].Ass;
        END;
          END;
        END;
      END;

      IF OnlyOpers THEN

        IF ReducePri > ShiftPri THEN
          Priority        := ReducePri;
          Associativity    := ReduceAss;
        ELSE
          Priority        := ShiftPri;
          Associativity    := ShiftAss;
        END;

        FOR item := Items TO Items + Size - 1 DO
          WITH ItemArrayPtr^[item] DO
        IF (Rep = RedRep) AND IsElement (LookAhead, Set) THEN
          prod := ADR (ProdArrayPtr^[Prod]);
          IF (prod^.Pri < Priority) THEN    (* lower priority    *)
            IF Verbose THEN
              InformLowPri (item, LookAhead);    (* ignore reduce    *)
            END;
            Exclude (Set, LookAhead);
            IF IsEmpty (Set) THEN Rep := NoRep; END;
          ELSIF (prod^.Pri = Priority) AND    (* max. priority    *)
             ((Associativity = right) OR    (* right associative    *)
             (Associativity = nonassoc)) AND    (* not associative    *)
             (ShiftPri = Priority) THEN        (* same priority    *)
            IF Verbose THEN
              InformRightAss (item, LookAhead);    (* ignore reduce    *)
            END;
            Exclude (Set, LookAhead);
            IF IsEmpty (Set) THEN Rep := NoRep; END;
          ELSE
            IF Verbose THEN
              InformKept (item, LookAhead);    (* keep reduce        *)
            END;
            INC (ReduceRest);
          END;
        ELSIF (Read = LookAhead) THEN
          IF (ShiftPri < Priority) THEN        (* lower priority    *)
            IF Verbose THEN
              InformLowPri (item, LookAhead);    (* ignore read        *)
            END;
            Rep := NoRep;
          ELSIF (ShiftPri = Priority) AND    (* max. priority    *)
             ((Associativity = left) OR        (* left associative    *)
             (Associativity = nonassoc)) AND    (* not associative    *)
             (ReducePri = Priority) THEN    (* same priority    *)
            IF Verbose THEN
              InformLeftAss (item, LookAhead);    (* ignore read        *)
            END;
            Rep := NoRep;
          ELSE
            IF Verbose THEN
              InformKept (item, LookAhead);    (* keep read        *);
            END;
            INC (ShiftRest);
          END;
        END;
          END;
        END;

      ELSE (* NOT OnlyOpers *)

        IF ShiftCount > 0 THEN    (* shift wird reduce vorgezogen *)

          FOR item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[item] DO
          IF (Rep = RedRep) AND (IsElement (LookAhead, Set)) THEN
            IF Verbose THEN
              InformIgnored (item, LookAhead);    (* ignore reduce *)
            END;
            Exclude (Set, LookAhead);
            IF IsEmpty (Set) THEN Rep := NoRep; END;
          ELSIF (Read = LookAhead) THEN
            IF Verbose THEN
              InformKept (item, LookAhead);
            END;
            INC (ShiftRest);
          END;
        END;
          END;

        ELSE    (* erstes reduce auswaehlen *)

          FOR item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[item] DO
          IF (Rep = RedRep) AND (IsElement (LookAhead, Set)) THEN
            prod := ADR (ProdArrayPtr^[Prod]);
            IF prod^.ProdNo = MinProdNo THEN
              IF Verbose THEN
            InformKept (item, LookAhead);        (* keep reduce *)
              END;
              INC (ReduceRest);
            ELSE
              IF Verbose THEN
            InformIgnored (item, LookAhead);    (* ignore reduce *)
              END;
              Exclude (Set, LookAhead);
              IF IsEmpty (Set) THEN Rep := NoRep; END;
            END;
          END;
        END;
          END;
        END;
      END;

      ConflictFree := FALSE;

      IF ReduceRest > 1 THEN
        IF ShiftRest > 0 THEN
          IF Verbose THEN
        InformConflict (ShRedRed);
          END;
          Include (ReadRedRedSet, LookAhead);
        ELSE
          IF Verbose THEN
        InformConflict (RedRed);
          END;
          Include (RedRedSet, LookAhead);
        END;
      ELSIF ReduceRest = 1 THEN
        IF ShiftRest > 0 THEN
          IF Verbose THEN
        InformConflict (ShRed);
          END;
          Include (ReadRedSet, LookAhead);
        ELSE (* reduce - no conflict *)
          ConflictFree := TRUE;
        END;
      ELSE (* ReduceRest = 0 *)
        ConflictFree := TRUE;
      END;

      IF Verbose THEN NewLine; END;
      IF ConflictFree THEN
        Exclude (ConflictSet, LookAhead);

        IF ReduceCount > 1 THEN
          IF ShiftCount > 0 THEN
        IF OnlyOpers THEN
          Include (RepReadRedRedSet, LookAhead);
        ELSE
          Include (ARepReadRedRedSet, LookAhead);
        END;
          ELSE (* ShiftCount = 0 *)
        IF OnlyOpers THEN
          Include (RepRedRedSet, LookAhead);
        ELSE
          Include (ARepRedRedSet, LookAhead);
        END;
          END;
        ELSIF ReduceCount = 1 THEN
          IF ShiftCount > 0 THEN
        IF OnlyOpers THEN
          Include (RepReadRedSet, LookAhead);
        ELSE
          Include (ARepReadRedSet, LookAhead);
        END;
          ELSE (* ShiftCount = 0 *)
        ERROR ('Check.RepairConflict: No Conflict (1)');
          END;
        ELSE (* ReduceCount = 0 *)
          ERROR ('Check.RepairConflict: No Conflict (2)');
        END;
      END;
    END;
      END;

      ErrorMessageI (eState, eInformation, NoPosition, eShort, ADR (state));

      IF NOT IsEmpty (ReadRedSet) THEN
    ErrorMessageI (eReadRed, eError, NoPosition, eTermSet, ADR (ReadRedSet));
      END;
      IF NOT IsEmpty (RedRedSet) THEN
    ErrorMessageI (eRedRed, eError, NoPosition, eTermSet, ADR (RedRedSet));
      END;
      IF NOT IsEmpty (ReadRedRedSet) THEN
    ErrorMessageI (eReadRedRed, eError, NoPosition, eTermSet, ADR (ReadRedRedSet));
      END;
      IF NOT IsEmpty (RepReadRedSet) THEN
    ErrorMessageI (eRepReadRed, eInformation, NoPosition, eTermSet, ADR (RepReadRedSet));
      END;
      IF NOT IsEmpty (RepRedRedSet) THEN
    ErrorMessageI (eRepRedRed, eInformation, NoPosition, eTermSet, ADR(RepRedRedSet));
      END;
      IF NOT IsEmpty (RepReadRedRedSet) THEN
    ErrorMessageI (eRepReadRedRed, eInformation, NoPosition, eTermSet, ADR(RepReadRedRedSet));
      END;
      IF NOT IsEmpty (ARepReadRedSet) THEN
    ErrorMessageI (eARepReadRed, eWarning, NoPosition, eTermSet, ADR(ARepReadRedSet));
      END;
      IF NOT IsEmpty (ARepRedRedSet) THEN
    ErrorMessageI (eARepRedRed, eWarning, NoPosition, eTermSet, ADR(ARepRedRedSet));
      END;
      IF NOT IsEmpty (ARepReadRedRedSet) THEN
    ErrorMessageI (eARepReadRedRed, eWarning, NoPosition, eTermSet, ADR(ARepReadRedRedSet));
      END;

      ReleaseSet (ReadRedSet);
      ReleaseSet (RedRedSet);
      ReleaseSet (ReadRedRedSet);
      ReleaseSet (RepReadRedSet);
      ReleaseSet (RepRedRedSet);
      ReleaseSet (RepReadRedRedSet);
      ReleaseSet (ARepReadRedSet);
      ReleaseSet (ARepRedRedSet);
      ReleaseSet (ARepReadRedRedSet);
      ReleaseSet (todo);
      IF Verbose THEN DebugEnd; END;
    END RepairConflict;

  PROCEDURE ERROR (a: ARRAY OF CHAR);
    VAR s: tString;
    BEGIN
      ArrayToString (a, s);
      ErrorMessageI (eInternal, eFatal, NoPosition, eString, ADR (s));
    END ERROR;

BEGIN
  Verbose := FALSE;
END Check.